home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / forth / pfe-0.000 / pfe-0 / pfe-0.9.13 / src / file.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-07-17  |  5.6 KB  |  281 lines
  1. /*
  2.  * This file is part of the portable Forth environment written in ANSI C.
  3.  * Copyright (C) 1995  Dirk Uwe Zoller
  4.  *
  5.  * This library is free software; you can redistribute it and/or
  6.  * modify it under the terms of the GNU Library General Public
  7.  * License as published by the Free Software Foundation; either
  8.  * version 2 of the License, or (at your option) any later version.
  9.  *
  10.  * This library is distributed in the hope that it will be useful,
  11.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13.  * See the GNU Library General Public License for more details.
  14.  *
  15.  * You should have received a copy of the GNU Library General Public
  16.  * License along with this library; if not, write to the Free
  17.  * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  *
  19.  * This file is version 0.9.13 of 17-July-95
  20.  * Check for the latest version of this package via anonymous ftp at
  21.  *    roxi.rz.fht-mannheim.de:/pub/languages/forth/pfe-VERSION.tar.gz
  22.  * or    sunsite.unc.edu:/pub/languages/forth/pfe-VERSION.tar.gz
  23.  * or    ftp.cygnus.com:/pub/forth/pfe-VERSION.tar.gz
  24.  *
  25.  * Please direct any comments via internet to
  26.  *    duz@roxi.rz.fht-mannheim.de.
  27.  * Thank You.
  28.  */
  29. /*
  30.  * file.c ---         The Optional File-Access Word Set and
  31.  *                      File-Access Extension Words.
  32.  * (duz 12Jul93)
  33.  */
  34.  
  35. #include "forth.h"
  36. #include "support.h"
  37.  
  38. #include <stdio.h>
  39. #include <errno.h>
  40.  
  41. #include "missing.h"
  42.  
  43. Code (bin)
  44. {
  45.   *sp += FMODE_BIN;
  46. }
  47.  
  48. Code (close_file)
  49. {
  50.   File *fid = (File *) sp[0];
  51.  
  52.   sp[0] = close_file (fid) ? errno : 0;
  53. }
  54.  
  55. Code (create_file)
  56. {
  57.   char *fn = (char *) sp[2];    /* c-addr, name */
  58.   uCell u = sp[1];        /* length of name */
  59.   Cell fam = sp[0];        /* file access mode */
  60.   File *fid = create_file (fn, u, fam);
  61.  
  62.   sp += 1;
  63.   sp[1] = (Cell) fid;
  64.   sp[0] = fid ? 0 : errno;
  65. }
  66.  
  67. Code (delete_file)
  68. {
  69.   char *fn = (char *) sp[1];    /* c-addr, name */
  70.   uCell u = sp[0];        /* length of name */
  71.   char fnz[PATH_LENGTH];    /* to store name in ascii-z format */
  72.  
  73.   sp += 1;
  74.   store_filename (fn, u, fnz, sizeof fnz);
  75.   sp[0] = remove (fnz) ? errno : 0;
  76. }
  77.  
  78. Code (file_position)
  79. {
  80.   File *fid = (File *) sp[0];    /* file-id */
  81.   long pos = ftell (fid->f);
  82.   udCell ud;
  83.  
  84.   sp -= 2;
  85.   if (pos != -1)
  86.     {
  87.       UL2UDC (pos, ud);
  88.       sp[0] = 0;        /* ior */
  89.     }
  90.   else
  91.     {
  92.       ud.lo = ud.hi = UCELL_MAX;
  93.       sp[0] = errno;        /* ior */
  94.     }
  95.   *(udCell *) &sp[1] = ud;    /* ud */
  96. }
  97.  
  98. Code (file_size)
  99. {
  100.   File *fid = (File *) sp[0];    /* fileid */
  101.   long size = fsize (fid->f);
  102.   udCell ud;
  103.  
  104.   sp -= 2;
  105.   if (size != -1)
  106.     {
  107.       UL2UDC (size, ud);
  108.       sp[0] = 0;        /* ior */
  109.     }
  110.   else
  111.     {
  112.       ud.lo = ud.hi = UCELL_MAX;
  113.       sp[0] = errno;        /* ior */
  114.     }
  115.   *(udCell *) &sp[1] = ud;    /* ud */
  116. }
  117.  
  118. Code (include_file)
  119. {
  120.   include_file ((File *) *sp++);
  121. }
  122.  
  123. Code (included)
  124. {
  125.   char *fn = (char *) sp[1];    /* c-addr, name */
  126.   uCell u = sp[0];        /* length of name */
  127.  
  128.   sp += 2;
  129.   included (fn, u);
  130. }
  131.  
  132. Code (open_file)
  133. {
  134.   char *fn = (char *) sp[2];    /* c-addr, name */
  135.   uCell u = sp[1];        /* length of name */
  136.   Cell fam = sp[0];        /* file access mode */
  137.   File *fid = open_file (fn, u, fam);
  138.  
  139.   sp += 1;
  140.   sp[1] = (Cell) fid;
  141.   sp[0] = fid ? 0 : errno;
  142. }
  143.  
  144. Code (read_file)
  145. {
  146.   char *c_addr = (char *) sp[2];
  147.   uCell u = sp[1];
  148.   File *fid = (File *) sp[0];
  149.   Cell r = read_file (c_addr, &u, fid);
  150.  
  151.   sp += 1;
  152.   sp[1] = u;
  153.   sp[0] = r;
  154. }
  155.  
  156. Code (read_line)
  157. {
  158.   char *c_addr = (char *) sp[2];
  159.   uCell u = sp[1];
  160.   File *fid = (File *) sp[0];
  161.   Cell ior;
  162.   int r = read_line (c_addr, &u, fid, &ior);
  163.  
  164.   sp[2] = u;
  165.   sp[1] = r;
  166.   sp[0] = ior;
  167. }
  168.  
  169. Code (reposition_file)
  170. {
  171.   File *fid = (File *) sp[0];
  172.   long pos = UDC2UL (sp[1], sp[2]);
  173.  
  174.   sp += 2;
  175.   sp[0] = reposition_file (fid, pos);
  176. }
  177.  
  178. Code (resize_file)
  179. {
  180.   File *fid = (File *) sp[0];
  181.   long size = UDC2UL (sp[1], sp[2]);
  182.  
  183.   sp += 2;
  184.   if (resize_file (fid, size) != 0)
  185.     *sp = errno;
  186.   else
  187.     *sp = 0, fid->size = (uCell) (size / BPBUF);
  188. }
  189.  
  190. Code (write_file)
  191. {
  192.   char *c_addr = (char *) sp[2];
  193.   uCell u = sp[1];
  194.   File *fid = (File *) sp[0];
  195.  
  196.   sp += 2;
  197.   sp[0] = write_file (c_addr, u, fid);
  198. }
  199.  
  200. Code (write_line)
  201. {
  202.   char *c_addr = (char *) sp[2];
  203.   uCell u = sp[1];
  204.   File *fid = (File *) sp[0];
  205.  
  206.   sp += 2;
  207.   if ((sp[0] = write_file (c_addr, u, fid)) == 0)
  208.     putc ('\n', fid->f);
  209. }
  210.  
  211. Code (file_status)
  212. {
  213.   int mode = file_access ((char *) sp[1], sp[0]);
  214.  
  215.   if (mode == -1)
  216.     {
  217.       sp[1] = 0;
  218.       sp[0] = errno;
  219.     }
  220.   else
  221.     {
  222.       sp[1] = mode;
  223.       sp[0] = 0;
  224.     }
  225. }
  226.  
  227. Code (flush_file)
  228. {
  229.   File *fid = (File *) sp[0];
  230.  
  231.   if (BLOCK_FILE == fid)
  232.     {
  233.       save_buffers_ ();
  234.       sp[0] = 0;
  235.     }
  236.   else
  237.     {
  238.       if (fflush (fid->f))
  239.     sp[0] = errno;
  240.       else
  241.     sp[0] = 0;
  242.     }
  243. }
  244.  
  245. Code (rename_file)
  246. {
  247.   char oldnm[PATH_LENGTH], newnm[PATH_LENGTH];
  248.  
  249.   store_filename ((char *) sp[3], sp[2], oldnm, sizeof oldnm);
  250.   store_filename ((char *) sp[1], sp[0], newnm, sizeof newnm);
  251.   sp += 3;
  252.   *sp = rename (oldnm, newnm) ? errno : 0;
  253. }
  254.  
  255. /* *INDENT-OFF* */
  256. LISTWORDS (file) =
  257. {
  258.   CO ("BIN",        bin),
  259.   CO ("CLOSE-FILE",    close_file),
  260.   CO ("CREATE-FILE",    create_file),
  261.   CO ("DELETE-FILE",    delete_file),
  262.   CO ("FILE-POSITION",    file_position),
  263.   CO ("FILE-SIZE",    file_size),
  264.   CO ("INCLUDE-FILE",    include_file),
  265.   CO ("INCLUDED",    included),
  266.   CO ("OPEN-FILE",    open_file),
  267.   OC ("R/O",        FMODE_RO),
  268.   OC ("R/W",        FMODE_RW),
  269.   CO ("READ-FILE",    read_file),
  270.   CO ("READ-LINE",    read_line),
  271.   CO ("REPOSITION-FILE",reposition_file),
  272.   CO ("RESIZE-FILE",    resize_file),
  273.   OC ("W/O",        FMODE_WO),
  274.   CO ("WRITE-FILE",    write_file),
  275.   CO ("WRITE-LINE",    write_line),
  276.   CO ("FILE-STATUS",    file_status),
  277.   CO ("FLUSH-FILE",    flush_file),
  278.   CO ("RENAME-FILE",    rename_file)
  279. };
  280. COUNTWORDS (file, "File-access + extensions");
  281.